perm filename CONNEW.F4[COL,LCS] blob sn#104313 filedate 1974-05-25 generic text, type T, neo UTF8
C  *******CONVERTS FROM MAGTAPE OR 2314 TO UDP OR 2314  ***********
C  DEC 17,1970  ********* CONVERTS 18 (AND 12) BIT .DMD FILES  ***********
C   CONVERTS .DMD FILES WRITTEN WITH RCDFLG←1; OR BIGBIT←1;(or ←2;)
C   LOAD WITH CVTIO.REL AND NORM.REL. 
C   TYPE 'X' IF FINAL NAME UNKNOWN OR IF DATA GOES BEYOND CURRENT TAPE.
C   1ST NAME OF EACH PAIR TYPED BY COMPUTER IS BASED ON NAME #1 YOU TYPED.
C   2ND IS ACTUAL NAME OF FILE.
C   IF NO MAXAMP IS TYPED AFTER NAME #1, IT WILL BE REQUESTED LATER.
C   TO BACK UP  TYPE '-1'. 'REWIND' MAY BE TYPED AFTER 'MTA0' OR 'NAME #1'.
C   USE 'TAPMUS' TO ADVANCE TAPE IF NEEDED.
	DIMENSION JSB(128),IBOTT(4096)
100	FORMAT(' TYPE NAME #1'/)
200	FORMAT(' TYPE FINAL NAME'/)
250	FORMAT(A1)
300	FORMAT(2XA5,2XI4,I9)
400	FORMAT(A5,2I)
450	FORMAT(' READ FROM MTA0?'/)
500	FORMAT(I,' WORDS,   FACTOR=',F6.3,',  MAXAMP=',I4/)
600	FORMAT(' MORE??'/)
700	FORMAT(' TYPE MAXAMP'/)
800	FORMAT(4I)
	EQUIVALENCE (JSB(2),JSB2),(JSB(3),JSB3),(JSB(4),JSB4)
  	MUSIC='MUSIC'
	CALL PUTMUS(MUSIC)
	FACTOR=1.
	N=9000
	JUDP=4
C   GARPLY READS 4*1024 WDS.
	JSIZE=1024
101	KSIZE=JSIZE
	MX=0
	KCNT=0
	IX=0
	JA=1
440	TYPE 450
	ACCEPT 250,TAPE
	IF(TAPE.NE.'R')GO TO 54
	REWIND 16
	TAPE='Y'
54	TYPE 100
	JNM='AAAAA'
	ACCEPT 400,NAME,MAXAMP
  	IF(MAXAMP.EQ.0)MAXAMP=MX
	IF(NAME.EQ.'-1')GO TO 440
	IF(NAME.EQ.'NO')GO TO 1201
C   CAN TYPE 'NO' IF MISTAKE EARLIER.
	IF(NAME.EQ.' ')NAME='MUSAA'
2	JNM=JNM+((NAME-JNM)/256*256)
	KNM=JNM
C   AUTOMATICALLY SETS BASIC NAME TO 'A' ENDING. 12-BIT SOUND NOT NORMALIZED.
1002	TYPE 200
	ACCEPT 400,NM2,KSKIP
	IF(NM2.EQ.'-1')GO TO 54
	IF(NM2.EQ.' ')NM2=NAME
	IF(TAPE.NE.'Y')GO TO 7077
	IF(MAXAMP.NE.0)GO TO 2710
	TYPE 700
	ACCEPT 800,MAXAMP
	IF(MAXAMP)GO TO 54
	IX=0
2710	IF(NM2.EQ.' ')NM2=NAME
1710	CALL GETTAP
1810	CALL INTAPE(JSB(1),128)
	IF(JSB(1))GO TO 1202
	TYPE 300,JSB3
	IF(IX.OR.JSB2.EQ.3)GO TO 2022
	IF(MAXAMP.EQ.0)MAXAMP=2040
	GO TO 199
7077	IF(MAXAMP.NE.0)GO TO 4022
	CALL GETFIL(NM2)
	CALL FASTIN(JSB(1),128)
	IF(JSB2.EQ.3)GO TO 4022
	JSC=JSB(1)
6066	CALL FASTIN(IBOTT(1),JSC)
	IF(IBOTT(JSC).EQ.0)GO TO 6066
     	MAXAMP=IABS(IBOTT(JSC))
4022	IF(N)GO TO 710
	N=-2
	IF(JSB2.EQ.3)GO TO 710 
199	FACTOR=2040./MAXAMP
    	MX=MAXAMP
	IX=-1
	KSIZE=3*JSIZE/2
	IF(TAPE.EQ.'Y')GO TO 2022
C  AMPL. WILL BE NEG. IF LSBUF WAS NOT FULL (LAST BUFFER).
710	IF(TAPE.EQ.'Y')GO TO 1810
   	CALL GETFIL(NAME)
810	CALL FASTIN(JSB(1),128)
	IF(JSB2.EQ.3)IX=0
2022	JSC=JSB(1)
1022	IF(JA.GT.KSIZE)GO TO 17
610	IF(TAPE.NE.'Y')CALL FASTIN(IBOTT(JA),JSC)
    	IF(TAPE.EQ.'Y')CALL INTAPE(IBOTT(JA),JSC)
C   LAST WORD IS THROWN AWAY.
	JA=JA+JSC-1
	JC=IBOTT(JA)
	IF(JC)5,1022,6
5	JA=JA-IBOTT(JA-1)
6	TYPE 300,NAME,JC,KCNT
	NAME=NAME+2
	IF(NAME.LE.JNM+50)GO TO 27
	JNM=JNM+256
	IF(JNM.LE.KNM+6400)GO TO 1017
	KNM=JNM+26112
	JNM=KNM
C   RAISES 'AAAZA' TO 'AABAA'
1017	NAME=JNM
27	IF(NAME.LE.NM2)GO TO 710
1202	TYPE 600
	ACCEPT 400,NAME
	IF(NAME.EQ.'YES'.OR.NAME.EQ.'Y')GO TO 440
1201	NM2=NAME-1
17	JC=JA-1
	IF(JC.LT.KSIZE)GO TO 23
10	IF(IX)CALL NORM(IBOTT(1),KSIZE,FACTOR)
	LSIZE=KSIZE
	JMP=-1
32	KCNT=KCNT+JSIZE
	CALL FSTMUS(IBOTT(1),JSIZE)
	IF(JMP)7,8,9
7	JC=JC-LSIZE
	DO 12 K=1,JC
12	IBOTT(K)=IBOTT(K+LSIZE)
	JA=JC+1
	IF(JC.GT.KSIZE)GO TO 10
	IF(NAME.LE.NM2)GO TO 610
23	IF(IX.EQ.0)GO TO 43
	CALL NORM(IBOTT(1),JC,FACTOR)
	JC=JC*2/3
43	DO 13 K=JC+1,JSIZE
13	IBOTT(K)=0
	JMP=0
	GO TO 32
8 	DO 14 K=1,JSIZE
14	IBOTT(K)=0
	JMP=1
	GO TO 32
9	K=KCNT/JSIZE
	L=K-(K/JUDP)*JUDP
	IF(L.EQ.0)GO TO 3222
	DO 4222 K=1,JSIZE
4222	IBOTT(K)=0
	DO 6222 K=1,L
6222	CALL FSTMUS(IBOTT(1),JSIZE)
	KCNT=KCNT+L*JSIZE
3222	CALL FINMUS
7222	TYPE 500,KCNT,FACTOR,MAXAMP
	END